home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb7.arc / TURBO.DOC < prev   
Text File  |  1984-11-17  |  9KB  |  334 lines
  1. TURBO Pascal routines, tips ,techniques, bugs, etc. etc. etc.
  2.  
  3. program timer ;
  4. type
  5.    dt = record
  6.            yyyy:   1980..1999;
  7.            mo:     01..12;
  8.            dd:     01..31;
  9.            hh:     00..23;
  10.            mm:     00..59;
  11.            ss:     00..59;
  12.  
  13.            hhh:    00..99;
  14.         end;
  15. procedure DateTime(var dtrec:dt);
  16. var
  17.    regpack : record
  18.                 ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  19.              end;
  20.  
  21. begin
  22.    with regpack do
  23.       begin
  24.          ax := swap($2c);       {load ah register with hex 2c}
  25.  
  26.          intr ($21,regpack);
  27.          dtrec.hh:=(hi(cx));
  28.          dtrec.mm:=lo(cx);
  29.          dtrec.ss:=hi(dx);
  30.          dtrec.hhh:=lo(dx);
  31.          ax := swap($2a);
  32.          intr ($21,regpack);
  33.          dtrec.yyyy:=cx;
  34.          dtrec.mo:=hi(dx);
  35.          dtrec.dd:=lo(dx);
  36.       end;
  37.  
  38. end;
  39.  
  40. var
  41.    dtrec:   dt;
  42.  
  43. begin
  44.    DateTime(dtrec);
  45.    write(dtrec.yyyy:6,dtrec.hh:4,dtrec.mm:4);
  46.    writeln;
  47.    readln;
  48. end.
  49.  
  50.  
  51. program cline ;
  52.  
  53. {This program illustrates the use of absolute variables in order to
  54.  get at the MSDOS command line buffer.  The manual says that it is
  55.  of length (hex) 80 and starts at location (hex) 80 in the program prefix.
  56.  Since the cseg register points to the prefix, it is an easy task
  57.  to define variable k which is the command line.  MSDOS' command
  58.  line conforms to PASCAL's idea of a string (length in first byte)
  59.  so we don't have to do anything special.}
  60.  
  61.  
  62. var k: string[$80] absolute cseg:$80 ;
  63.  
  64.  
  65. begin
  66.  writeln('k is ''',k,'''') ;
  67.  {notice that the string begins with at least one blank}
  68.  writeln('it''s length is ',length(k)) ;
  69.  readln ;
  70. end.
  71.  
  72. ***************************************************************************
  73.  
  74. PROGRAM TOOLS; {  Various System and Data Utilities for Turbo Pascal   }
  75.                {           Joe Doran  September 23, 1984               }
  76.  
  77. TYPE
  78.   str2 = string[2];      str15 = string[15];
  79.   str8 = string[8];      str25 = string[25];
  80.  
  81.   register = record
  82.     ax,bx,cx,dx,bp,si,ds,es,flags: integer;
  83.     END;
  84.  
  85. VAR
  86.   i,j,k,l,m,n: integer;
  87.   Tst,KeyByte,KeyScan: byte;
  88.   KeyChar: char;
  89.  
  90. { -------------------------------------------------------------------- }
  91.  
  92. FUNCTION HexRep(Arg:byte): str2;  { Hex Representation of Byte Value }
  93.  
  94. CONST
  95.   HexDigit: array[0..15] of char = '0123456789ABCDEF';
  96.  
  97. BEGIN
  98.   HexRep := 'XX';
  99.   HexRep[1] := HexDigit[Arg shr  4];
  100.   HexRep[2] := HexDigit[Arg and 15];
  101. END;
  102.  
  103. { -------------------------------------------------------------------- }
  104.  
  105. FUNCTION BitRep(Arg:byte): str8;  { Bit Representation of Byte Value }
  106.  
  107. BEGIN
  108.   BitRep := '00000000';
  109.   if arg and   1 > 0 then BitRep[8] := '1';
  110.   if arg and   2 > 0 then BitRep[7] := '1';
  111.   if arg and   4 > 0 then BitRep[6] := '1';
  112.   if arg and   8 > 0 then BitRep[5] := '1';
  113.   if arg and   6 > 0 then BitRep[4] := '1';
  114.   if arg and  32 > 0 then BitRep[3] := '1';
  115.   if arg and  64 > 0 then BitRep[2] := '1';
  116.   if arg and 128 > 0 then BitRep[1] := '1';
  117. END;
  118.  
  119. { -------------------------------------------------------------------- }
  120.  
  121. PROCEDURE RegDump(IntrArgs:register);  { Display Interrupt Registers}
  122.  
  123. BEGIN
  124.   WITH IntrArgs do
  125.     BEGIN
  126.       Writeln;
  127.       Write('AX = ',HexRep(hi(ax)),HexRep(lo(ax)),'H  ');
  128.         Write(BitRep(hi(ax)),' ',BitRep(lo(ax)),'B');
  129.       Write('    BX = ',HexRep(hi(bx)),HexRep(lo(bx)),'H  ');
  130.         Writeln(BitRep(hi(bx)),' ',BitRep(lo(bx)),'B');
  131.       Write('CX = ',HexRep(hi(cx)),HexRep(lo(cx)),'H  ');
  132.         Write(BitRep(hi(cx)),' ',BitRep(lo(cx)),'B');
  133.       Write('    DX = ',HexRep(hi(dx)),HexRep(lo(dx)),'H  ');
  134.         Writeln(BitRep(hi(dx)),' ',BitRep(lo(dx)),'B');
  135.       Write('BP = ',HexRep(hi(bp)),HexRep(lo(bp)),'H  ');
  136.         Write(BitRep(hi(bp)),' ',BitRep(lo(bp)),'B');
  137.       Write('    SI = ',HexRep(hi(si)),HexRep(lo(si)),'H  ');
  138.         Writeln(BitRep(hi(si)),' ',BitRep(lo(si)),'B');
  139.       Write('DS = ',HexRep(hi(ds)),HexRep(lo(ds)),'H  ');
  140.         Write(BitRep(hi(ds)),' ',BitRep(lo(ds)),'B');
  141.       Write('    ES = ',HexRep(hi(es)),HexRep(lo(es)),'H  ');
  142.         Writeln(BitRep(hi(es)),' ',BitRep(lo(es)),'B');
  143.       Write('FL = ',HexRep(hi(flags)),HexRep(lo(flags)),'H  ');
  144.         Writeln(BitRep(hi(flags)),' ',BitRep(lo(flags)),'B');
  145.       Writeln;
  146.     END;
  147. END;
  148.  
  149. { -------------------------------------------------------------------- }
  150.  
  151. FUNCTION SysTime: str8;  { System Time in HH:MM:SS format }
  152.  
  153. TYPE
  154.   register = record
  155.     ax,bx,cx,dx,bp,si,ds,es,flags: integer;
  156.     END;
  157.  
  158. VAR
  159.   IntrArgs: register;
  160.   hr,mn,sc: string[2];
  161.  
  162. BEGIN
  163.   WITH IntrArgs do
  164.     BEGIN
  165.       ax := $2C00;
  166.       intr($21,IntrArgs);
  167.       str((cx shr 8):2,hr);   if hr[1] = ' ' then hr[1] := '0';
  168.       str((cx mod 256):2,mn); if mn[1] = ' ' then mn[1] := '0';
  169.       str((dx shr 8):2,sc);   if sc[1] = ' ' then sc[1] := '0';
  170.     END;
  171.   SysTime := hr+':'+mn+':'+sc;
  172. END;
  173.  
  174. { -------------------------------------------------------------------- }
  175.  
  176. FUNCTION SysDate: str8;  { System Date in MM/DD/YY format }
  177.  
  178. TYPE
  179.   register = record
  180.     ax,bx,cx,dx,bp,si,ds,es,flags: integer;
  181.     END;
  182.  
  183. VAR
  184.   IntrArgs: register;
  185.   yr,mn,dy: string[2];
  186.   yr4: string[4];
  187.  
  188. BEGIN
  189.   WITH IntrArgs do
  190.     BEGIN
  191.       ax := $2A00;
  192.       intr($21,IntrArgs);
  193.       str(cx:4,yr4); yr := copy(yr4,3,2);
  194.       str(hi(dx):2,mn); if mn[1] = ' ' then mn[1] := '0';
  195.       str(lo(dx):2,dy); if dy[1] = ' ' then dy[1] := '0';
  196.     END;
  197.   SysDate := mn+'/'+dy+'/'+yr;
  198. END;
  199.  
  200. { -------------------------------------------------------------------- }
  201.  
  202. FUNCTION MemSize: integer;  { System Memory Size (in 1K blocks) }
  203.  
  204. TYPE
  205.   register = record
  206.     ax,bx,cx,dx,bp,si,ds,es,flags: integer;
  207.     END;
  208.  
  209. VAR
  210.   IntrArgs: register;
  211.  
  212. BEGIN
  213.   WITH IntrArgs do
  214.     BEGIN
  215.       intr($12,IntrArgs);
  216.       MemSize := ax;
  217.     END;
  218. END;
  219.  
  220. { -------------------------------------------------------------------- }
  221.  
  222. FUNCTION OptDevs: integer;  { Optional Equipment Indicators }
  223.  
  224. TYPE
  225.   register = record
  226.     ax,bx,cx,dx,bp,si,ds,es,flags: integer;
  227.     END;
  228.  
  229. VAR
  230.   IntrArgs: register;
  231.  
  232. BEGIN
  233.   WITH IntrArgs do
  234.     BEGIN
  235.       intr($11,IntrArgs);
  236.       OptDevs := ax;
  237.     END;
  238. END;
  239.  
  240. { -------------------------------------------------------------------- }
  241.  
  242. FUNCTION BiosVer: str8;  { IBM PC BIOS Release Marker }
  243.  
  244. VAR
  245.   RomDate: array[1..8] of char absolute $FFFF:$0005;
  246.  
  247. BEGIN
  248.   BiosVer := RomDate;
  249. END;
  250.  
  251. { -------------------------------------------------------------------- }
  252.  
  253. FUNCTION SysModel:str25;  { IBM PC System Model Identification (maybe) }
  254.  
  255. VAR
  256.   SysCode: byte absolute $F000:$FFFE;
  257.   WrkCode: byte;
  258.  
  259. BEGIN
  260.   WrkCode := SysCode - $FC;
  261.   Case WrkCode of
  262.     0: SysModel := 'IBM Personal Computer AT';
  263.     1: SysModel := 'IBM PCjr.';
  264.     2: SysModel := 'IBM PC XT or Portable PC';
  265.     3: SysModel := 'IBM Personal Computer';
  266.   Else
  267.        SysModel := 'Unrecognized System';
  268.   END;
  269. END;
  270.  
  271. { -------------------------------------------------------------------- }
  272.  
  273. PROCEDURE InKey(Var KBchar,KBscan:byte);  { Read Keyboard Codes }
  274.  
  275. TYPE
  276.   register = record
  277.     ax,bx,cx,dx,bp,si,ds,es,flags: integer;
  278.     END;
  279.  
  280. VAR
  281.   IntrArgs: register;
  282.  
  283. BEGIN
  284.   WITH IntrArgs do
  285.     BEGIN
  286.       ax := $0000;
  287.       intr($16,IntrArgs);
  288.       KBchar := lo(ax);
  289.       KBscan := hi(ax);
  290.     END;
  291. END;
  292.  
  293. { -------------------------------------------------------------------- }
  294.  
  295. BEGIN
  296.   ClrScr;
  297.   Writeln('TOOLS.PAS  -----  Joe Doran  -----  23SEP84');
  298.   Writeln;
  299.   Writeln('The System Time is................. ',SysTime);
  300.   Writeln('The System Date is................. ',SysDate);
  301.   Writeln;
  302.   Writeln('The Model Type is.................. ',SysModel);
  303.   Writeln('The BIOS in this system is dated... ',BiosVer);
  304.   Writeln('The System Memory Size is.......... ',MemSize,'KB');
  305.   Write('The Equipment Flags are............ ');
  306.     Writeln(BitRep(hi(OptDevs)),' ',BitRep(lo(OptDevs)));
  307.   Writeln;
  308.   Writeln('Keyboard exercise follows:');
  309.   Writeln;
  310.   KeyChar := 'A';
  311.   While KeyChar <> ' ' do
  312.     BEGIN
  313.       Writeln;
  314.       Writeln('Press any key for decoding; press space-bar to terminate.');
  315.       Writeln;
  316.       InKey(KeyByte,KeyScan);
  317.       KeyChar := chr(KeyByte);
  318.       if KeyScan > 0 then
  319.         BEGIN
  320.           Write('Chr(',KeyChar,')  ');
  321.           Write('ASCII:  Hex(',HexRep(KeyByte),')');
  322.           Write('  Bit(',BitRep(KeyByte),')');
  323.           Writeln('  Val(',KeyByte:3,')');
  324.           Write('        Scan:   Hex(',HexRep(KeyScan),')');
  325.           Write('  Bit(',BitRep(KeyScan),')');
  326.           Writeln('  Val(',KeyScan:3,')');
  327.         END;
  328.     END;
  329. END.
  330.  
  331. *** APPENDED 09/24/84 08:50:49 BY $MS ***
  332. R;
  333.  
  334. 8